home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / AmigaUtil / ExecUtil.mod < prev    next >
Text File  |  1994-08-08  |  8KB  |  339 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: ExecUtil.mod $
  4.   Description: Support for clients of exec.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.2 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:09:11 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE ExecUtil;
  18.  
  19. (*
  20. ** $C- CaseChk       $I- IndexChk  $L+ LongAdr   $N- NilChk
  21. ** $P- PortableCode  $R- RangeChk  $S- StackChk  $T- TypeChk
  22. ** $V- OvflChk       $Z- ZeroVars
  23. *)
  24.  
  25. IMPORT E := Exec, SYS := SYSTEM;
  26.  
  27. TYPE
  28.  
  29.   CompareProc * = PROCEDURE ( n1, n2 : E.MinNodePtr ) : INTEGER;
  30.  
  31.  
  32. (*--------------------------------------------------------------------*)
  33. (*
  34.   Exec List handling procedures
  35. *)
  36.  
  37.  
  38. (*------------------------------------*)
  39. PROCEDURE NewList* (VAR list : E.MinList);
  40.  
  41. BEGIN (* NewList *)
  42.   list.head := SYS.ADR (list.tail);
  43.   list.tail := NIL;
  44.   list.tailPred := SYS.ADR (list.head)
  45. END NewList;
  46.  
  47.  
  48. (*------------------------------------*)
  49. PROCEDURE GetSucc * ( node : E.MinNodePtr ) : E.MinNodePtr;
  50.  
  51. BEGIN (* GetSucc *)
  52.   IF node # NIL THEN
  53.     node := node.succ; IF node.succ = NIL THEN node := NIL END
  54.   END; (* IF *)
  55.   RETURN node;
  56. END GetSucc;
  57.  
  58.  
  59. (*------------------------------------*)
  60. PROCEDURE GetPred * ( node : E.MinNodePtr ) : E.MinNodePtr;
  61.  
  62. BEGIN (* GetPred *)
  63.   IF node # NIL THEN
  64.     node := node.pred; IF node.pred = NIL THEN node := NIL END
  65.   END; (* IF *)
  66.   RETURN node;
  67. END GetPred;
  68.  
  69.  
  70. (*------------------------------------*)
  71. PROCEDURE GetHead * ( VAR list : E.MinList ) : E.MinNodePtr;
  72.  
  73. VAR node : E.MinNodePtr;
  74.  
  75. BEGIN (* GetHead *)
  76.   node := list.head; IF node.succ = NIL THEN node := NIL END;
  77.   RETURN node;
  78. END GetHead;
  79.  
  80.  
  81. (*------------------------------------*)
  82. PROCEDURE GetTail * ( VAR list : E.MinList ) : E.MinNodePtr;
  83.  
  84. VAR node : E.MinNodePtr;
  85.  
  86. BEGIN (* GetTail *)
  87.   node := list.tailPred; IF node.pred = NIL THEN node := NIL END;
  88.   RETURN node;
  89. END GetTail;
  90.  
  91.  
  92. (*------------------------------------*)
  93. PROCEDURE ListLength * ( VAR list : E.MinList ) : LONGINT;
  94.  
  95. VAR node : E.MinNodePtr; count : LONGINT;
  96.  
  97. BEGIN (* ListLength *)
  98.   count := 0; node := list.head;
  99.   WHILE node.succ # NIL DO INC (count); node := node.succ END;
  100.   RETURN count;
  101. END ListLength;
  102.  
  103.  
  104. (*------------------------------------*)
  105. PROCEDURE NodeAt * ( VAR list : E.MinList; pos : LONGINT )
  106.   : E.MinNodePtr;
  107.  
  108. VAR node : E.MinNodePtr; count : LONGINT;
  109.  
  110. BEGIN (* NodeAt *)
  111.   count := pos; node := list.head;
  112.   IF node # NIL THEN
  113.     WHILE (node.succ # NIL) & (count > 0) DO
  114.       DEC( count ); node := node.succ;
  115.     END;
  116.     IF node.succ = NIL THEN node := NIL END
  117.   END;
  118.   RETURN node
  119. END NodeAt;
  120.  
  121.  
  122. (*------------------------------------*)
  123. PROCEDURE InsertAt *
  124.   ( VAR list : E.MinList; node : E.MinNodePtr; pos : LONGINT );
  125.  
  126. VAR oldNode : E.MinNodePtr;
  127.  
  128. BEGIN (* InsertAt *)
  129.   oldNode := NodeAt (list, pos);
  130.   IF oldNode = NIL THEN E.base.AddTail (list, node)
  131.   ELSE E.base.Insert (list, node, oldNode.pred)
  132.   END
  133. END InsertAt;
  134.  
  135.  
  136. (*------------------------------------*)
  137. PROCEDURE InsertOrdered *
  138.   ( VAR list : E.MinList; node : E.MinNodePtr; Compare : CompareProc )
  139.   : LONGINT;
  140.  
  141. VAR prevNode, nextNode : E.MinNodePtr; position : LONGINT;
  142.  
  143. BEGIN (* InsertOrdered *)
  144.   position := 0; prevNode := NIL; nextNode := GetHead (list);
  145.   WHILE (nextNode # NIL) & (Compare (node, nextNode) >= 0) DO
  146.     prevNode := nextNode; nextNode := GetSucc (nextNode);
  147.     INC (position)
  148.   END;
  149.   E.base.Insert (list, node, prevNode);
  150.   RETURN position;
  151. END InsertOrdered;
  152.  
  153.  
  154. (*------------------------------------*)
  155. PROCEDURE RemoveAt * ( VAR list : E.MinList; pos : LONGINT )
  156.   : E.MinNodePtr;
  157.  
  158. VAR node : E.MinNodePtr;
  159.  
  160. BEGIN (* RemoveAt *)
  161.   node := NodeAt( list, pos );
  162.   IF node # NIL THEN E.base.Remove (node) END;
  163.   RETURN node;
  164. END RemoveAt;
  165.  
  166.  
  167. (*--------------------------------------------------------------------*)
  168. (*
  169.   Exec MessagePort procedures.
  170. *)
  171.  
  172.  
  173. (*------------------------------------*)
  174. (*$D-*)
  175. PROCEDURE CreatePort * (portName : ARRAY OF CHAR; priority : SHORTINT)
  176.   : E.MsgPortPtr;
  177.  
  178.   VAR sigBit : SHORTINT; mp : E.MsgPortPtr; name : E.STRPTR;
  179.  
  180. BEGIN (* CreatePort *)
  181.   sigBit := E.base.AllocSignal (-1);
  182.   IF sigBit = -1 THEN RETURN NIL END;
  183.  
  184.   SYS.NEW (mp, SIZE (E.MsgPort), {E.memPublic, E.memClear});
  185.   IF mp = NIL THEN E.base.FreeSignal (sigBit); RETURN NIL END;
  186.  
  187.   IF portName = "" THEN name := NIL ELSE name := SYS.ADR (portName) END;
  188.   mp.name := name;
  189.   mp.pri := priority;
  190.   mp.type := E.ntMsgPort;
  191.   mp.mpFlags := E.paSignal;
  192.   mp.sigBit := sigBit;
  193.   mp.sigTask := E.base.FindTask (NIL); (* Find THIS task. *)
  194.  
  195.   IF name # NIL THEN E.base.AddPort (mp)
  196.   ELSE NewList (mp.msgList)
  197.   END;
  198.  
  199.   RETURN mp
  200. END CreatePort;
  201.  
  202. (*------------------------------------*)
  203. PROCEDURE DeletePort * (mp : E.MsgPortPtr);
  204.  
  205. BEGIN (* DeletePort *)
  206.   IF mp = NIL THEN RETURN END;
  207.  
  208.   (* if it was public ... *)
  209.   IF mp.name # NIL THEN E.base.RemPort (mp) END;
  210.  
  211.   (* make it difficult to re-use the port *)
  212.   mp.sigTask := SYS.VAL (E.TaskPtr, -1);
  213.   mp.msgList.head := SYS.VAL (E.MinNodePtr, -1);
  214.  
  215.   E.base.FreeSignal (mp.sigBit);
  216.   SYS.DISPOSE (mp)
  217. END DeletePort;
  218.  
  219. (*--------------------------------------------------------------------*)
  220. (*
  221.   Exec IO procedures.
  222. *)
  223.  
  224.  
  225. (*------------------------------------*)
  226. PROCEDURE BeginIO * ( ioReq : E.IORequestPtr );
  227.  
  228. BEGIN (* BeginIO *)
  229.   SYS.PUTREG (9, ioReq); (* MOVE.L  ioReq(A5), A1 *)
  230.   SYS.INLINE (
  231.     2C69H, 0014H,        (* MOVE.L  0014(A1), A6  *)
  232.     4EAEH, -001EH );     (* JSR     FFE2(A6)      *)
  233. END BeginIO;
  234.  
  235. (*------------------------------------*)
  236. PROCEDURE CreateExtIO *
  237.   ( port   : E.MsgPortPtr;
  238.     ioSize : INTEGER )
  239.   : E.APTR;
  240.  
  241.   VAR ioReq : E.IORequestPtr;
  242.  
  243. BEGIN (* CreateExtIO *)
  244.   IF port = NIL THEN RETURN NIL END;
  245.   SYS.NEW (ioReq, ioSize, {E.memPublic, E.memClear});
  246.   IF ioReq # NIL THEN
  247.     ioReq.type := E.ntReplyMsg;
  248.     ioReq.mnLength := ioSize;
  249.     ioReq.replyPort := port
  250.   END;
  251.   RETURN ioReq
  252. END CreateExtIO;
  253.  
  254. (*------------------------------------*)
  255. PROCEDURE DeleteExtIO ( ioReq : E.APTR );
  256.  
  257.   VAR req : E.IORequestPtr;
  258.  
  259. BEGIN (* DeleteExtIO *)
  260.   IF ioReq # NIL THEN
  261.     req := ioReq;
  262.     req.succ := SYS.VAL (E.MinNodePtr, -1);
  263.     req.replyPort := SYS.VAL (E.MsgPortPtr, -1);
  264.     SYS.DISPOSE (req)
  265.   END
  266. END DeleteExtIO;
  267.  
  268. (*------------------------------------*)
  269. PROCEDURE CreateStdIO* ( port : E.MsgPortPtr ) : E.IOStdReqPtr;
  270.  
  271. BEGIN (* CreateStdIO *)
  272.   RETURN CreateExtIO (port, SIZE (E.IOStdReq))
  273. END CreateStdIO;
  274.  
  275. (*------------------------------------*)
  276. PROCEDURE DeleteStdIO* ( ioReq : E.IOStdReqPtr );
  277.  
  278. BEGIN (* DeleteStdIO *)
  279.   DeleteExtIO (ioReq)
  280. END DeleteStdIO;
  281.  
  282. END ExecUtil.
  283.  
  284. (*------------------------------------*)
  285. PROCEDURE CreateTask *
  286.   ( name      : ARRAY OF CHAR;
  287.     pri       : SHORTINT;
  288.     initPC    : E.PROC;
  289.     stackSize : ULONG )
  290.   : E.TaskPtr;
  291.  
  292.   VAR
  293.     taskMemList : RECORD (E.Node)
  294.       numEntries : INTEGER;
  295.       entries : ARRAY 2 OF RECORD
  296.         reqs : SET;
  297.         size : LONGINT;
  298.       END;
  299.     END;
  300.     memList : CPOINTER TO RECORD (E.MemList)
  301.       entries : ARRAY 2 OF E.MemEntry;
  302.     END;
  303.     newTask : E.TaskPtr;
  304.  
  305. BEGIN (* CreateTask *)
  306.   stackSize := SYS.AND (stackSize + 3, 0FFFFFFFCH);
  307.   taskMemList.type := E.ntUnknown;
  308.   taskMemList.pri := 0;
  309.   taskMemList.name := NIL;
  310.   taskMemList.numEntries := 2;
  311.   taskMemList.entries[0].reqs := {E.memPublic, E.memClear};
  312.   taskMemList.entries[0].size := SIZE (E.Task);
  313.   taskMemList.entries[1].reqs := {E.memClear};
  314.   taskMemList.entries[1].size := stackSize;
  315.   memList := E.base.AllocEntry (SYS.ADR (taskMemList));
  316.   IF 31 IN SYS.VAL (SET, memList) THEN RETURN NIL END;
  317.  
  318.   newTask := memList.entries[0].addr;
  319.   newTask.type := E.ntTask;
  320.   newTask.pri := pri;
  321.   newTask.name := SYS.ADR (name);
  322.   newTask.spLower := memList.entries[1].addr;
  323.   newTask.spUpper :=
  324.     SYS.VAL (E.APTR, SYS.VAL (LONGINT, newTask.spLower) + stackSize);
  325.   newTask.spReg := newTask.spUpper;
  326.  
  327.   NewList (newTask.memEntry);
  328.   E.base.AddHead (newTask.memEntry, memList);
  329.   E.base.AddTask (newTask, initPC, NIL);
  330.   RETURN newTask
  331. END CreateTask;
  332.  
  333. (*------------------------------------*)
  334. PROCEDURE DeleteTask * ( task : E.TaskPtr );
  335.  
  336. BEGIN (* DeleteTask *)
  337.   E.base.RemTask (task)
  338. END DeleteTask;
  339.